home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 5
/
Aminet 5 - March 1995.iso
/
Aminet
/
util
/
batch
/
Randomcopy0_91.lha
/
RandomCopy
/
rc.e
< prev
Wrap
Text File
|
1994-11-21
|
8KB
|
338 lines
/* Randomcopy.e COPYRIGHT 1993 by Chad Randall (crandall) */
MODULE 'dos/dos','dos/dosextens','dos/dosasl','exec/tasks'
/* Sorry, I like global variables. Could be from 10 years of Basic/asm...*/
DEF source[150]:STRING
DEF dest[150]:STRING
DEF work[150]:STRING
DEF work2[150]:STRING
DEF argarray[16]:LIST
DEF userndfile=FALSE,fha=0,bb=0
DEF i,t,quietflag,cloneflag,seconds,micros,random,dd,ticksflag,waittime,longbreak
DEF rdarg,noreqflag,minwait,maxwait,buffersize=512
DEF workfh=NIL:PTR TO filehandle,
destfh=NIL:PTR TO filehandle
DEF apath=NIL:PTR TO anchorpath
DEF datestamp=NIL:PTR TO datestamp,comment[100]:STRING,condom
CONST AOK=69 /* GRIN 8-> */
CONST NOT_AOK=666 /* Just a joke... or is it? >:"> */
ENUM ERR_NONE,ERR_INCORRECT,ERR_DOS,ERR_NOSOURCE,ERR_NODEST,ERR_MINMIN,ERR_MINMAX,
ERR_MAXMIN,ERR_MAXMAX,ERR_MIN_MORE_MAX,ERR_BUFFER_TO_SMALL,ERR_NOMEM,
ERR_CTRLC
RAISE ERR_CTRLC IF CtrlC ()=TRUE
PROC main() HANDLE
IF KickVersion(37)=NIL
WriteF('\nGet OS2.x (maybe a nice A1200?)\n')
CleanUp(21)
ENDIF
IF FreeStack()<3000 /*I can't seem to test this. E seems to*/
WriteF('Not enough free stack space.\n') /* have it's own stack?*/
CleanUp(21)
ENDIF
CurrentTime({seconds},{micros})
random:=RndQ(seconds)
/* An attempt to get a pseudo-randomized number! */
/*Let's hope this doesn't slow down too bad on non '30 machines...*/
CurrentTime({seconds},{micros})
FOR i:=0 TO micros/1000
dd:=Rnd(i)
ENDFOR
rdarg:=ReadArgs('FROM/A,TO/A,MIN=MINWAIT/N,MAX=MAXWAIT/N,UT=USETICKS/S,LB=LONGBREAK/S,QUIET/S,CLONE/S,NOREQ/S,BUF=BUFFER/K/N,RNDFILE/S,ABOUT/S',argarray,0)
IF rdarg>0
IF argarray[0]<>NIL
StrCopy(source,argarray[0],ALL)
ENDIF
IF argarray[1]<>NIL
StrCopy(dest,argarray[1],ALL)
ENDIF
IF argarray[2]<>NIL
minwait:=argarray[2]
minwait:=^minwait
IF (minwait<1) THEN Raise(ERR_MINMIN)
IF (minwait>9999) THEN Raise(ERR_MINMAX)
ENDIF
IF argarray[3]<>NIL
maxwait:=argarray[3]
maxwait:=^maxwait
IF (maxwait<2) THEN Raise(ERR_MAXMIN)
IF (maxwait>10000) THEN Raise(ERR_MAXMAX)
IF (maxwait<=minwait) THEN Raise(ERR_MIN_MORE_MAX)
ENDIF
IF argarray[4]<>NIL
ticksflag:=TRUE
ENDIF
IF argarray[5]<>NIL
longbreak:=TRUE
ENDIF
IF argarray[6]<>NIL
quietflag:=TRUE
ENDIF
IF argarray[7]<>NIL
cloneflag:=TRUE
ENDIF
IF argarray[8]<>NIL
noreqflag:=TRUE
ENDIF
IF argarray[9]<>NIL
buffersize:=argarray[9]
buffersize:=^buffersize
IF (buffersize=0 OR buffersize>65000)
Raise(ERR_BUFFER_TO_SMALL)
ENDIF
ENDIF
IF argarray[10]<>NIL
userndfile:=TRUE
ENDIF
IF argarray[11]<>NIL
instructions()
ENDIF
FreeArgs(rdarg)
ELSE
Raise(ERR_DOS)
ENDIF
CtrlC()
bb:=[0,0,0,0,0,0,0]:LONG
IF (userndfile)
fha:=Open('s:randomcopy.seed',MODE_OLDFILE)
IF fha
Read(fha,bb,4)
random:=RndQ(Long(bb))
Close(fha)
ENDIF
ENDIF
docopy()
IF (userndfile)
fha:=Open('s:randomcopy.seed',MODE_NEWFILE)
IF fha
random:=RndQ(random);random:=RndQ(random);random:=RndQ(random)
PutLong(bb,random)
Write(fha,bb,4)
Close(fha)
ENDIF
ENDIF
IF (minwait OR maxwait)
IF (maxwait<minwait)
maxwait:=minwait
ENDIF
IF ticksflag=NIL
minwait:=minwait*50
maxwait:=maxwait*50
ENDIF
WHILE TRUE<>FALSE /* Will be broken by Ctrl-C ONLY! */
waittime:=maxwait-minwait+1
waittime:=Rnd(waittime)
waittime:=waittime+minwait
CtrlC()
IF ((waittime<100) OR (longbreak))
Delay(waittime)
ELSE
t:=waittime/100
FOR i:=0 TO t
CtrlC()
Delay(100)
ENDFOR
t:=waittime-(t*100)
Delay(t)
ENDIF
docopy()
ENDWHILE
ENDIF
EXCEPT
SELECT exception
CASE ERR_INCORRECT
quietprint('incorrect arguments')
CASE ERR_DOS
IF quietflag=NIL
PrintFault(IoErr(),'randomcopy')
ENDIF
CASE ERR_MINMIN
quietprint('minimum wait is too small')
CASE ERR_MINMAX
quietprint('minimum wait is too large')
CASE ERR_MAXMIN
quietprint('maximum wait is too small')
CASE ERR_MAXMAX
quietprint('maximum wait is too large')
CASE ERR_MIN_MORE_MAX
quietprint('minimum is greater than maximum')
CASE ERR_BUFFER_TO_SMALL
quietprint('illegal buffersize size')
CASE ERR_NOMEM
quietprint('not enough memory available')
CASE ERR_CTRLC
quietprint('***Break')
ENDSELECT
IF (apath) THEN MatchEnd(apath);apath:=NIL
IF (destfh) THEN Close(destfh);destfh:=NIL /* Try to make sure we unlock all */
IF (workfh) THEN Close(workfh);workfh:=NIL
CleanUp(11)
ENDPROC
PROC quietprint(str)
IF quietflag=NIL
WriteF('randomcopy: \s\n',str)
ENDIF
ENDPROC
PROC docopy()
DEF fileinfo=NIL:PTR TO fileinfoblock
DEF achain=NIL:PTR TO achain
DEF err,pathlen,filestart,first,chance=1
DEF newdate=NIL:PTR TO datestamp
filestart:=FilePart(source)
pathlen:=filestart-source
IF (pathlen)
StrCopy(work,source,pathlen)
ELSE
StrCopy(work,'',ALL)
ENDIF
apath:=New(SIZEOF anchorpath)
datestamp:=New(SIZEOF datestamp)
/* fileinfo:=New(SIZEOF fileinfoblock) */
err:=NIL;first:=FALSE
WHILE err=NIL
CtrlC()
IF first=FALSE
err:=MatchFirst(source,apath)
first:=TRUE
ELSE
err:=MatchNext(apath)
ENDIF
IF (err)
IF (err=ERROR_NO_MORE_ENTRIES)
IF chance>1
copyfile()
ELSE
Raise(ERR_DOS)
ENDIF
ELSE
Raise(ERR_DOS)
ENDIF
ELSE
achain:=apath.last
IF (achain)
fileinfo:=achain.info
IF (fileinfo.direntrytype)<0
IF (fileinfo)
IF(Rnd(chance))=NIL
StrCopy(work2,fileinfo.filename,ALL)
IF cloneflag
StrCopy(comment,fileinfo.comment,ALL)
condom:=fileinfo.protection
newdate:=fileinfo.datestamp
datestamp.days:=newdate.days
datestamp.minute:=newdate.minute
datestamp.tick:=newdate.tick
ENDIF
ENDIF
chance:=chance+1
ENDIF
ENDIF
ENDIF
ENDIF
ENDWHILE
MatchEnd(apath);apath:=NIL
ENDPROC
PROC copyfile()
DEF filesize
DEF cont=FALSE,numbytes,buffer,numbytes2
buffer:=New(buffersize)
IF (buffer=0)
Raise(ERR_NOMEM)
ENDIF
StrAdd(work,work2,ALL)
IF quietflag=NIL
WriteF('Copying \s TO \s\n',work,dest)
ENDIF
CtrlC()
IF(filesize:=FileLength(work))>0
CtrlC()
IF (workfh:=Open(work,MODE_OLDFILE))
CtrlC()
IF (destfh:=Open(dest,MODE_NEWFILE))
WHILE cont=FALSE
CtrlC()
numbytes:=Read(workfh,buffer,buffersize)
IF numbytes=-1
Raise(ERR_DOS)
ELSE
IF numbytes=0
cont:=TRUE
ELSE
numbytes2:=Write(destfh,buffer,numbytes)
IF numbytes<buffersize
cont:=TRUE
ENDIF
ENDIF
ENDIF
ENDWHILE
ELSE
Raise(ERR_DOS)
ENDIF
ELSE
Raise(ERR_DOS)
ENDIF
ELSE
Raise(ERR_DOS)
ENDIF
IF (destfh) THEN Close(destfh);destfh:=NIL
IF (workfh) THEN Close(workfh);workfh:=NIL
IF cloneflag
IF (SetFileDate(dest,datestamp))=FALSE THEN Raise(ERR_DOS)
IF (SetComment(dest,comment))=FALSE THEN Raise(ERR_DOS)
/* V V V -ALWAYS a good idea!!! */
IF (SetProtection(dest,condom))=FALSE THEN Raise(ERR_DOS)
ENDIF
ENDPROC
PROC instructions()
IF quietflag=NIL
WriteF('\nRandomcopy version .90 December 28, 1993.\n')
WriteF('This program is copyright ®1993 by Chad Randall\n')
WriteF('and may be freely distributed.\n')
WriteF('\n')
WriteF(' EMAIL:crandall@garnet.msen.com\n')
WriteF(' USNAIL:Chad Randall, 229 S.Washington St.,\n')
WriteF(' Manchester, Michigan 48158-9680, USA.\n')
WriteF('\n')
ENDIF
ENDPROC
CHAR '$VER: randomcopy 0.90 © 1993 Chad Randall (28.12.93)',0